unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Printers, PrnUtils, StdCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Label1: TLabel;
    cmbPorts: TComboBox;
    lblPrinterName: TLabel;
    lblHandle: TLabel;
    lblPort: TLabel;
    btnAddForm: TButton;
    lbForms: TListBox;
    edtName: TEdit;
    edtX: TEdit;
    edtY: TEdit;
    Label2: TLabel;
    Y: TLabel;
    cmbFlags: TComboBox;
    Label3: TLabel;
    btnDeleteForm: TButton;
    procedure FormCreate(Sender: TObject);
    procedure cmbPortsChange(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnAddFormClick(Sender: TObject);
    procedure btnDeleteFormClick(Sender: TObject);
  private
    { Private declarations }
    FPrns: TPrinterList;
    FhPrn: THandle;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
uses WinSpool;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
  //ListBox1.Items := Printer.Printers;
  //for i := 0 to ListBox1.Items.Count - 1 do
  //  cmbPorts.Items.Add( TPrinterDevice(ListBox1.Items.Objects[i]).Port);
  FPrns := TPrinterList.Create;
  EnumLocalPrinters(FPrns);
  for i := 0 to FPrns.Count - 1 do
    with FPrns[i] do
      ListBox1.Items.Add(Format('%s', [Device]));
  cmbFlags.ItemIndex := 2;    
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ClosePrinter(FhPrn);
  FPrns.Free;
end;

procedure TForm1.cmbPortsChange(Sender: TObject);
begin
  lblPrinterName.Caption := GetPrinterByPort(cmbPorts.Text);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var name: string;
begin
  name := ListBox1.Items[ListBox1.ItemIndex];
  lblPort.Caption := FPrns[ListBox1.ItemIndex].Port;
  ClosePrinter(FhPrn);
  if not OpenPrinter(PChar(name), FhPrn, nil) then
    RaiseLastWin32Error;
  lblHandle.Caption := IntToStr(FhPrn);
  EnumPrnForms(FhPrn, lbForms.Items);
end;

procedure TForm1.btnAddFormClick(Sender: TObject);
var pForm: PFormInfo1;
begin
  New(pForm);
  try
    FillChar(pForm^, SizeOf(pForm^), 0);
    with pForm^ do begin
      pName := PChar(edtName.Text);
      Size.cx := StrToInt(edtX.Text) * 1000;
      Size.cy := StrToInt(edtY.Text) * 1000;
      ImageableArea.Right := Size.cx;
      ImageableArea.Bottom := Size.cy;
      Flags := cmbFlags.ItemIndex;
    end;
    if not AddForm(FhPrn, 1, pForm) then
      RaiseLastWin32Error;
  finally
    Dispose(pForm);
  end;
end;

procedure TForm1.btnDeleteFormClick(Sender: TObject);
var s: string;
begin
  s := lbForms.Items[lbForms.ItemIndex];
  Delete(s, Pos('[', s) - 1, 255);
  s := Trim(s);
  if not DeleteForm(FhPrn, PChar(s)) then RaiseLastWin32Error;
  lbForms.Items.Delete(lbForms.ItemIndex);
end;

end.
